home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1995 January / Simtel - 10000 MSDOS Shareware Programs (Walnut Creek)(January 1995)(Disc 2).ISO / disc2 / turbopas / twoscrn.pas < prev    next >
Pascal/Delphi Source File  |  1985-07-06  |  2KB  |  74 lines
  1. program twoscrn;
  2. {demonstration of two screen operation}
  3. {(c) 1985 by nathan liskov, waltham mass}
  4. {free to use but not to sell}
  5. var
  6.   n:integer;
  7.   mpos:array [0..31] of array [0..1] of integer;
  8.  
  9. procedure saveparam(imode:integer);     {save screen state}
  10. var
  11.   n:integer;
  12. begin
  13.   for n:=0 to 29 do
  14.   mpos[n,imode]:=mem[0:1097+n];
  15.   mpos[30,imode]:=wherey;
  16.   mpos[31,imode]:=wherex;
  17. end;
  18.  
  19. procedure restoreparam(imode:integer);     {restore screen state}
  20. var
  21.   n:integer;
  22. begin
  23.   for n:=0 to 29 do
  24.   mem[0:1097+n]:=mpos[n,imode];
  25.   gotoxy(mpos[31,imode],mpos[30,imode]);
  26. end;
  27.  
  28. procedure tocolor;     {to color monitor}
  29. begin
  30.   saveparam(0);        {save mono screen state}
  31.   mem[0:1040]:=(mem[0:1040] and 207) or 32;    {to color monitor}
  32.   restoreparam(1);     {restore previous color screen state}
  33. end;
  34.  
  35. procedure tomono;     {to mono monitor}
  36. begin
  37.   saveparam(1);       {save color screen state}
  38.   mem[0:1040]:=(mem[0:1040] and 207) or 48;      {to mono monitor}
  39.   restoreparam(0);    {restore previous mono screen state}
  40. end;
  41.  
  42. procedure setupscreens;     {save mono and color screen states}
  43. begin                       {ends up on mono monitor}
  44.  if (mem[0:1040] and 207)=207 then  {if current monitor is mono then...}
  45.  begin
  46.   saveparam(0);      {save mono screen state}
  47.   mem[0:1040]:=(mem[0:1040] and 207) or 32; {to color screen}
  48.  end else
  49.  begin
  50.   saveparam(1)       {save color screen state}
  51.  end;
  52.  textmode(0);
  53.  textbackground(1);
  54.  mem[0:1040]:=(mem[0:1040] and 207) or 48;  {to mono screen}
  55.  textmode;
  56. end;
  57.  
  58. begin
  59.  setupscreens;
  60.  tocolor;
  61.  graphcolormode;
  62.  graphbackground(1);
  63.  for n:=1 to 20 do
  64.  begin
  65.   tomono;
  66.   writeln('here i am! ',n);
  67.   tocolor;
  68.   draw(0,0,32*n,2*n*n,1);
  69. {  gotoxy(1+n,2*n-1);}
  70.   writeln('no here i am! ',n);
  71.  end;
  72.  tomono;
  73. end.
  74.